home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 07 - 1991 / 07.10 Oct 91 / Jorg October / FileM.f < prev    next >
Encoding:
Text File  |  1991-08-27  |  9.8 KB  |  418 lines  |  [TEXT/MPS ]
  1. ! FileM.f 
  2. ! Created 8/27/91 9:37 by AppMaker 
  3.  
  4. !!MP inlines.f
  5. !!G JLtest.finc.f
  6.  
  7. !!D+
  8. !!R+
  9. !!OV+
  10. !!S FileM 
  11.  
  12. !----------
  13.     Subroutine InitFileM
  14.     integer*2 dialogTop, dialogLeft
  15.     integer*2 numOpenTypes
  16.     record /SFTypeList/ openTypeList
  17.     logical errorflag
  18.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  19.     dialogTop        = 75
  20.     dialogLeft        = 85
  21.  
  22.     numOpenTypes = 1
  23.     openTypeList.SFT(0).OST = 'TEXT'
  24.         !add code here: File init
  25.     End !InitFileM
  26.  
  27. !----------
  28.     Logical Function OkToOpen (fType)
  29.     record /OSType/ fType
  30.     integer*2 dialogTop, dialogLeft
  31.     integer*2 numOpenTypes
  32.     record /SFTypeList/ openTypeList
  33.     logical errorflag
  34.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  35.     integer*2    i, status, searching, found, notFound
  36.     Parameter(searching=0, found=1, notFound=2)
  37.  
  38.     i = 0
  39.     status = searching
  40.     do while (status = searching)
  41.         if (i >= numOpenTypes) then 
  42.             status = notFound
  43.         else 
  44.             if (fType.OST = openTypeList.SFT(i).OST) then 
  45.                 status = found
  46.             else 
  47.                 i = i + 1
  48.             end if
  49.         end if
  50.     end do
  51.     OkToOpen = (status = found)
  52.     End !OkToOpen
  53.  
  54. !----------
  55.     Logical Function OpenApplFile (vRefNum, fName, fRefNum)
  56.     integer*2 vRefNum, fRefNum
  57.     String*255 fName
  58.     integer*2 dialogTop, dialogLeft
  59.     integer*2 numOpenTypes
  60.     record /SFTypeList/ openTypeList
  61.     logical errorflag
  62.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  63.     Logical*2 CheckOS
  64.     logical ok
  65.  
  66.     !add code here: open a file
  67.     ok = CheckOS (FSOpen (fName, vRefNum, %ref(fRefNum)))
  68.     OpenApplFile = ok
  69.     End !OpenApplFile
  70.  
  71. !----------
  72.     Subroutine CloseApplFile (fRefNum)
  73.     include 'Globals.inc'
  74.     integer*2 fRefNum
  75.     integer*2 dialogTop, dialogLeft
  76.     integer*2 numOpenTypes
  77.     record /SFTypeList/ openTypeList
  78.     logical errorflag
  79.     Logical*2 CheckOS
  80.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  81.     logical ok
  82.     !add code here: close a file
  83.       if (cur^.windowKind = 1) then  !1st or only window in set
  84.         ok = CheckOS (FSClose (fRefNum))
  85.     end if
  86.     End !CloseApplFile
  87.  
  88. !----------
  89.     Subroutine SaveApplFile (fRefNum)
  90.     include 'Globals.inc'
  91.     integer*2 fRefNum
  92.     integer*2 dialogTop, dialogLeft
  93.     integer*2 numOpenTypes
  94.     record /SFTypeList/ openTypeList
  95.     logical errorflag
  96.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  97.  
  98.     !add code here: save a file
  99.     cur^.dirty = .false.
  100.     End !SaveApplFile
  101.  
  102. !----------
  103.     Logical Function ReadApplFile (fRefNum)
  104.     integer*2 fRefNum
  105.     integer*2 dialogTop, dialogLeft
  106.     integer*2 numOpenTypes
  107.     record /SFTypeList/ openTypeList
  108.     logical errorflag
  109.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  110.  
  111.     !add code here: read a file
  112.       ReadApplFile = .false.
  113.     End !ReadApplFile
  114.  
  115. !----------
  116.     Subroutine DoNew
  117.     integer*2 dialogTop, dialogLeft
  118.     integer*2 numOpenTypes
  119.     record /SFTypeList/ openTypeList
  120.     logical errorflag
  121.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  122.     record /StringHandle/ nameHandle        
  123.     String*255 name
  124.  
  125.     nameHandle.shdl = GetString (UntitledID)
  126.     name = nameHandle.shdl^.sptr^
  127.     call OpenWindows (name, INT2(0), INT2(0))
  128.     End !DoNew
  129.  
  130. !----------
  131.     Subroutine OpenFile (fileName, vRefNum)
  132.     String*255 fileName
  133.     integer*2 vRefNum, fRefNum
  134.     integer*2 dialogTop, dialogLeft
  135.     integer*2 numOpenTypes
  136.     record /SFTypeList/ openTypeList
  137.     logical errorflag
  138.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  139.  
  140.     if (OpenApplFile (vRefNum, fileName, fRefNum)) then 
  141.         Call OpenWindows (fileName, vRefNum, fRefNum)
  142.     end if    
  143.     End !OpenFile
  144.  
  145. !----------
  146.     Subroutine DoOpen
  147.     integer*2 dialogTop, dialogLeft
  148.     integer*2 numOpenTypes
  149.     record /SFTypeList/ openTypeList
  150.     logical errorflag
  151.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  152.     record /point/    dialogOrigin
  153.     record /SFReply/ sfInfo            
  154.  
  155.     Call SetPt (%ref(dialogOrigin), dialogLeft, dialogTop)
  156.     Call SFGetFile (dialogOrigin, '', nil, numOpenTypes, openTypeList, nil, %ref(sfInfo))
  157.     if (sfinfo.good) then 
  158.         Call openFile (sfinfo.fName, sfinfo.vRefNum)
  159.     end if
  160.     End !DoOpen
  161.  
  162. !----------
  163.     Subroutine Open0Files
  164.     integer*2 dialogTop, dialogLeft
  165.     integer*2 numOpenTypes
  166.     record /SFTypeList/ openTypeList
  167.     logical errorflag
  168.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag
  169.  
  170.     Call DoNew
  171.     End !Open0Files
  172.  
  173. !----------
  174.     Subroutine DoSaveAs
  175.     include 'Globals.inc'
  176.     integer*2 dialogTop, dialogLeft
  177.     integer*2 numOpenTypes
  178.     record /SFTypeList/ openTypeList
  179.     logical errorflag
  180.     record /SFReply/ sfInfo            
  181.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
  182.     integer*2 fRefNum
  183.     logical ok
  184.     record /StringHandle/ prompt, untitled            
  185.     String*255 suggestion
  186.     logical OpenApplFile
  187.     logical*2 CreateFile
  188.  
  189.     prompt.shdl = GetString (SaveAsPromptID)
  190.     suggestion = ''
  191.  
  192.         if (CreateFile (sfInfo, prompt.shdl^.sptr^, suggestion, %val('XXXX'), %val('TEXT'))) then 
  193.             if (cur^.fileNum <> 0) then 
  194.                 Call CloseApplFile (cur^.fileNum)
  195.             end if
  196.             if (OpenApplFile (sfinfo.vRefNum, sfinfo.fName, fRefNum)) then 
  197.                 Call SetWTitle (curWindow, sfinfo.fName)
  198.                 cur^.fileNum = fRefNum
  199.                 cur^.volNum = sfinfo.vRefNum
  200.                 Call SaveApplFile (cur^.fileNum)
  201.             else  !should never happen
  202.                 untitled.shdl = GetString (UntitledID)
  203.                 Call SetWTitle (curWindow, untitled.shdl^.sptr^)
  204.                 cur^.fileNum = 0
  205.                 cur^.volNum = 0
  206.             end if
  207.         end if
  208.     End !DoSaveAs
  209.  
  210. !----------
  211.     Subroutine DoSave
  212.     include 'Globals.inc'
  213.     integer*2 dialogTop, dialogLeft
  214.     integer*2 numOpenTypes
  215.     record /SFTypeList/ openTypeList
  216.     logical errorflag
  217.     record /SFReply/ sfInfo            
  218.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
  219.  
  220.     if (cur^.fileNum = 0) then 
  221.         Call DoSaveAs
  222.     else 
  223.         Call SaveApplFile (cur^.fileNum)
  224.     end if
  225.     End !DoSave
  226.  
  227. !----------
  228.     Subroutine CloseApplWindow
  229.     include 'Globals.inc'
  230.     integer*2 dialogTop, dialogLeft
  231.     integer*2 numOpenTypes
  232.     record /SFTypeList/ openTypeList
  233.     logical errorflag
  234.     record /SFReply/ sfInfo            
  235.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
  236.     integer*2 saveItem, cancelItem, discardItem
  237.     Parameter(saveItem = 1, cancelItem = 2, discardItem = 3)
  238.     pointer /WindowRecord/ Wpeek
  239.     String*255 curTitle
  240.     integer*2 itemNum
  241.     logical ok
  242.     
  243.  
  244.     ok = .true.
  245.     Wpeek = FrontWindow()
  246.     If (Wpeek^.windowkind = FORTWindow) then
  247.         Call F_CloseOutPWindow
  248.     else
  249.         Call SetInfo (Wpeek)
  250.         if (cur^.dirty) then 
  251.             Call GetWTitle (curWindow, curTitle)
  252.             Call ParamText (curTitle, '', '', '')
  253.             Call InitCursor
  254.             itemNum = Alert (SaveID, nil)
  255.             Select Case (itemNum)
  256.                 Case (saveItem) 
  257.                     Call DoSave
  258.                     ok = .not. errorFlag
  259.                 Case (discardItem)
  260.                        !Do nothing
  261.                 Case (cancelItem) 
  262.                     errorFlag = .true.
  263.                     ok = .false.
  264.             end select
  265.         end if
  266.         if (ok) then 
  267.             if (cur^.fileNum <> 0) then 
  268.                 Call CloseApplFile (cur^.fileNum)
  269.             end if
  270.             Call CloseCurWindow
  271.         end if
  272.     end if
  273.     End !CloseApplWindow
  274.  
  275. !----------
  276.     Subroutine DoClose
  277.     integer*2 dialogTop, dialogLeft
  278.     integer*2 numOpenTypes
  279.     record /SFTypeList/ openTypeList
  280.     logical errorflag
  281.     record /SFReply/ sfInfo            
  282.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
  283.     pointer /WindowRecord/ frontPeek        
  284.  
  285.     errorFlag = .false.
  286.  
  287.     frontPeek = FrontWindow()
  288.     if (frontPeek^.windowKind < 0) then 
  289.         Call CloseDeskAcc (frontPeek^.windowKind)
  290.     else if (frontPeek^.windowKind = dialogKind) then 
  291.         Call CloseModelessDialog (FrontWindow())
  292.     else 
  293.         Call CloseApplWindow
  294.     end if
  295.     End !DoClose
  296.  
  297. !----------
  298.     Subroutine DoQuit
  299.     include 'Globals.inc'
  300.     integer*2 dialogTop, dialogLeft
  301.     integer*2 numOpenTypes
  302.     record /SFTypeList/ openTypeList
  303.     logical errorflag
  304.     record /SFReply/ sfInfo            
  305.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
  306.     logical quitting
  307.     pointer /WindowRecord/ wpeek
  308.     Integer*4 OutputWindow
  309.     External OutputWindow
  310.     
  311.     quitting = .true.
  312.     If (OutputWindow() .NE. nil) Call SendBehind(OutputWindow(),nil)
  313.     do while (quitting .and. (FrontWindow() <> nil)) 
  314.         Wpeek = FrontWindow()
  315.         Call SystemTask
  316.         If (Wpeek^.windowkind = FORTWindow) then
  317.             Call DoMenu('File','Quit')
  318.             Call ExitFORTRAN
  319.         else
  320.             Call DoClose
  321.         end if
  322.         if (errorFlag) then 
  323.             quitting = .false.
  324.         end if
  325.     end do
  326.     
  327.     if (quitting) then 
  328.         quittingTime = .true.
  329.     end if
  330.     End !DoQuit
  331.  
  332.     !----------
  333.     Subroutine DoRevert
  334.     include 'globals.inc'
  335.     String*255    fileName
  336.     Logical    ok, ReadApplFile
  337.     Logical*2 Confirm
  338.     
  339.         ok = .true.
  340.         If (cur^.dirty) then 
  341.             Call GetWTitle (curWindow, fileName)
  342.             Call ParamText (fileName, '', '', '')
  343.             ok = Confirm (RevertID)
  344.         end if
  345.         If (ok) ok = ReadApplFile (cur^.fileNum)
  346.  
  347.         If (ok) Call InvalRect (curWindow^.portRect)
  348.     End !DoRevert
  349.  
  350.     !----------
  351.         Subroutine DoPageSetup 
  352.         record /THPrint/ myprintHdl
  353.         common /PrintStuff/ myPrintHdl
  354.         Integer*4 sz
  355.         logical*2 confirmed
  356.         
  357.         sz = Jsizeof(Tprint)
  358.         MyprintHdl.TH = NewHandle(sz)    !grab some memory for the print record
  359.         if (MyprintHdl.TH = nil) Stop "Print Handle not allocated!"
  360.         call propen    !Start Printing
  361.         confirmed=PrStlDialog(MyprintHdl)
  362.         If (.not. confirmed) then
  363.             Call DisposHandle(MyprintHdl)
  364.             MyprintHdl.TH = nil
  365.         end if
  366.         call prclose
  367.         !add code here: PageSetup action
  368.         End !DoPageSetup 
  369.  
  370.  
  371. !----------
  372.     Subroutine DoPrint 
  373.     !add code here: Print action
  374.     End !DoPrint 
  375.  
  376. !----------
  377.     Subroutine DoFile (itemNr)
  378.     integer*2 dialogTop, dialogLeft, itemNr
  379.     integer*2 numOpenTypes
  380.     record /SFTypeList/ openTypeList
  381.     logical errorflag
  382.     record /SFReply/ sfInfo            
  383.     Common /FileStuff/ dialogTop, dialogLeft, numOpenTypes, openTypeList,errorflag,sfinfo
  384.  
  385.     errorFlag = .false.
  386.  
  387.     select case (itemNr)
  388.         case(FileNew)
  389.             Call DoNew 
  390.         
  391.         case(FileOpen)
  392.             Call DoOpen 
  393.         
  394.         case(FileClose)
  395.             Call DoClose 
  396.         
  397.         case(FileSave)
  398.             Call DoSave 
  399.         
  400.         case(FileSaveAs)
  401.             Call DoSaveAs 
  402.         
  403.         case(FileRevert)
  404.             Call DoRevert 
  405.         
  406.         case(FilePageSetup)
  407.             Call DoPageSetup 
  408.         
  409.         case(FilePrint)
  410.             Call DoPrint 
  411.         
  412.         case(FileQuit)
  413.             Call DoQuit 
  414.         
  415.          
  416.     end select
  417.     End !DoFile 
  418.